home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0041_R2D2 Noises.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  4KB  |  162 lines
  1.  
  2. {
  3. If anyone can fill me in on how to output in stereo, I'd be very
  4. appreciative... I've heard that port $220/$221 is for left channel,
  5. $222/$223 is for the right, but that doesn't make any sense...does it?
  6.  
  7. This code makes R2D2 noises on a SoundBlaster until you press ESC.
  8.  
  9. {adapted from SS4CH.PAS by Frank Hirsch}
  10. USES Crt;
  11.  
  12. const sampleSize=4096;
  13. var sampleData:array[0..sampleSize-1]of byte;
  14. const samplePos:longint=0;
  15. var sampleSpeed:longint;
  16. var sampleDelta:longint;
  17.  
  18. const resetPort =$226;
  19. const readPort  =$22A;
  20. const writePort =$22C;
  21. const dataAvailPort=$22E;
  22.  
  23. function readByte:byte;begin
  24.  repeat until shortInt(port[dataAvailPort])<0;
  25.  readByte:=port[readPort];
  26.  end;
  27.  
  28. procedure initDSP;begin
  29.  port[resetPort]:=1;
  30.  delay(1);
  31.  port[resetPort]:=0;
  32.  repeat until readByte=$AA;
  33.  end;
  34.  
  35. var counter:longint;
  36.  
  37. procedure timerInt;assembler;asm
  38.   push ax
  39.   push bx
  40.   push dx
  41.   push di
  42.   push ds
  43.   push es
  44.   mov ax,seg @DATA
  45.   mov ds,ax
  46.  
  47.   mov es,[segB800]
  48.   xor byte ptr es:[0],$21
  49.  
  50.   mov bx,[word ptr samplePos+2]
  51.   mov ah,byte ptr sampleData[bx]
  52.   mov dx,[word ptr sampleSpeed]    {next sample byte}
  53.   add [word ptr samplePos],dx
  54.   adc bx,[word ptr sampleSpeed+2]
  55.   and bx,[sampleSize-1]
  56.   mov [word ptr samplePos+2],bx
  57.   mov bx,[word ptr sampleDelta]
  58.   add [word ptr sampleSpeed],bx
  59.   mov bx,[word ptr sampleDelta+2]
  60.   adc [word ptr sampleSpeed+2],bx
  61.   mov dx,writePort
  62.  @P2:              {ready for output byte?}
  63.   in al,dx
  64.   test al,$80
  65.   jnz @P2
  66.   mov al,ah
  67.   out dx,al
  68.  
  69.   mov al,$20       {process interrupt}
  70.   out $20,al
  71. {  sti}
  72.                    {prep NEXT output}
  73.  @P1:              {ready for command?}
  74.   in al,dx
  75.   test al,$80
  76.   jnz @P1
  77.   mov al,$10       {set up a DAC output}
  78.   out dx,al
  79.  
  80.   db $66; inc word ptr [counter]
  81.  
  82.   pop es
  83.   pop ds
  84.   pop di
  85.   pop dx
  86.   pop bx
  87.   pop ax
  88.   iret
  89.   end;
  90.  
  91. var
  92.   vec08:pointer absolute 0:8*4;
  93.   old08:pointer;
  94.  
  95. procedure setTimerTics(tics:word);begin
  96.   asm cli; end;
  97.   port[$43]:=$36;
  98.   port[$40]:=lo(tics);
  99.   port[$40]:=hi(tics);
  100.   asm sti end;
  101.   end;
  102.  
  103. procedure setTimerFreq(freq:word);begin
  104.   setTimerTics(succ(word($1234DC div freq)));
  105.   end;
  106.  
  107. procedure stopTimer;begin setTimerTics(0); end;
  108.  
  109. procedure writeByte(b:byte);begin
  110.   repeat until shortInt(port[writePort])>=0;
  111.   port[writePort]:=b;
  112.   end;
  113.  
  114. procedure speaker(onOff:boolean);begin
  115.   if onOff then writeByte($D1)
  116.   else writeByte($D3);
  117.   end;
  118.  
  119. var i,j,n:word;
  120.  
  121. const rate=16384;
  122.  
  123. procedure note(freq,dur,slide:longint);
  124. begin
  125.   counter:=0;
  126.   sampleSpeed:=freq*sampleSize*(65536 div rate);
  127.   sampleDelta:=slide;
  128.   dur:=(dur*rate)div 1000;
  129.   repeat
  130.     if port[$60]=$81 then break;
  131.     until counter>=dur;
  132.   end;
  133.  
  134.  
  135. begin
  136.  initDSP;
  137.  for i:=0 to sampleSize-1 do
  138.    sampleData[i]:=round(sin(i*pi/(sampleSize shr 1))*127.5+127.5);
  139.  old08:=vec08;
  140.  speaker(true);
  141.  writeByte($10);  {prep sb for data}
  142.  asm cli end;
  143.  vec08:=@timerInt;
  144.  asm sti end;
  145.  setTimerFreq(rate);
  146.  repeat
  147.    case random(4) of
  148.      0:note(random(1900)+60,(random(2)*80)+40,integer(random(3))-1);
  149.      1:note(random(800)+450,(random(2)*80)+140,integer(random(2049))
  150.                                                               -1024);
  151.      2:note(0,(random(2)+1)*40,0);
  152.      3:note(random(30)+15,(random(2)*80)+40,random(2));
  153.      end;
  154.    until port[$60]=$81;
  155.  stopTimer;
  156.  asm cli end;
  157.  vec08:=old08;
  158.  asm sti end;
  159.  speaker(false);  {it's probably gonna eat this as data}
  160.  speaker(false);
  161.  end.
  162.